home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb13.arc / DIR2.PAS < prev    next >
Pascal/Delphi Source File  |  1980-01-01  |  3KB  |  125 lines
  1. program Dir2;
  2.  
  3. {This program displays the default directory plus the free space
  4.  on both disks. It works only on MS-DOS (or PC-DOS) version 2. It
  5.  assumes a screen 80 columns wide and at least 24 lines deep.   }
  6.  
  7. Type
  8.   regpack = record
  9.               case integer of
  10.                 1: (ax,bx,cx,dx,bp,si,di,ds,es,flags: integer);
  11.                 2: (al,ah,bl,bh,c,ch,dl,dh         : byte)
  12.             end;
  13.  
  14.   dtaarray =    array[0..42] of byte;
  15.   dtacharray =  array[0..42] of char;
  16.  
  17. const
  18.    getdta =       $1a;
  19.    get1stdir =    $4e;
  20.    getnextdir =   $4f;
  21.    getfreespace = $36;
  22.  
  23. var
  24.    filestr:        string[14];
  25.    dta:            dtaarray;
  26.    cdta:           dtacharray absolute dta;
  27.    tsize:          byte;
  28.    x,y:            Integer;
  29.  
  30. procedure DTAcall;
  31.  
  32. var
  33.   regs:       regpack;
  34.  
  35. begin
  36.   with regs do begin
  37.     ah := getdta;
  38.     ds := seg(dta);
  39.     dx := ofs(dta);
  40.     MsDos(regs)
  41.   end
  42. end; {DTAcall}
  43.  
  44. procedure Firstcall(var errflag:    byte);
  45.  
  46. var
  47.   regs:       regpack;
  48.  
  49. begin
  50.   with regs do begin
  51.     ah := get1stdir;
  52.     cx := 0;
  53.     ds := seg(filestr);
  54.     dx := ofs(filestr[1]);
  55.     MsDos(regs);
  56.     if (flags and 1) = 1 then errflag:= lo(ax)
  57.       else errflag:= 0
  58.   end
  59. end; {firstcall}
  60.  
  61. procedure Nextcall(var errflag:    byte);
  62.  
  63. var
  64.   regs:       regpack;
  65.  
  66. begin
  67.   regs.ah := getnextdir;
  68.   MsDos(regs);
  69.   if (regs.flags and 1) = 1 then errflag:= regs.al
  70.   else errflag:= 0
  71. end; {nextcall}
  72.  
  73. Function Freespace(drive: char):real;
  74.  
  75. var
  76.   regs:       regpack;
  77.   fr:          real;
  78.  
  79. begin
  80.   with regs do begin
  81.     dx := ord(drive) - 64;
  82.     ah := getfreespace;
  83.     MsDos(regs);                       { call function }
  84.     fr := bx;
  85.     if ax > 0 then Freespace  := fr * ax * cx
  86.     else freespace:= 0
  87.   end
  88. end; {freespace}
  89.  
  90. Procedure loaddir;
  91.  
  92. var
  93.    i, j:   integer;
  94.    err:    byte;
  95.  
  96. begin
  97.   clrscr;
  98.   gotoxy(35,2);
  99.   write('DIRECTORY');
  100.   filestr:= '*.*';
  101.   fillchar(dta, 42, 0);
  102.   DTAcall;
  103.   Firstcall(err);
  104.   j:= 0;
  105.   repeat
  106.     gotoxy(((j mod 3)*28)+1, (j div 3) + 4);
  107.     i:= 30;
  108.     while dta[i] <> 0 do begin
  109.       write(cdta[i]);
  110.       i:= i + 1
  111.     end;
  112.     for i:= i to 42 do write(' ');
  113.     write(dta[26] + 256. * dta[27] + 65536. * dta[28]:5:0, ' bytes');
  114.     j:= j + 1;
  115.     Nextcall(err)
  116.   until err <> 0;
  117.   gotoxy(1,23);
  118.   write('Drive A: ', freespace('A'):6:0, ' bytes free.');
  119.   gotoxy(50,23);
  120.   writeln('Drive B: ', freespace('B'):6:0, ' bytes free.');
  121. end; {loaddir}
  122.  
  123. begin
  124.   loaddir
  125. end.